home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / ms_dos / lib / happyps3 / 3moku.pas next >
Encoding:
Pascal/Delphi Source File  |  1995-02-07  |  9.7 KB  |  207 lines
  1. {*********************************************************************
  2.  *  *** 三目並べ ***                                                 *
  3.  *                                                                   *
  4.  *        HAPPyのサンプルプログラム                                  *
  5.  *          (作者  浅野比富美 Public Domain Software)                *
  6.  *********************************************************************}
  7.  
  8. program TicTacToe(input,output)             ;   { 英語で tic-tac-toeという.  }
  9.   const o          =  1                     ;   { 先手 ○  または 先手の勝ち.}
  10.         n{othing}  =  0                     ;   { 空き     または 引き分け.  }
  11.         x          = -o                     ;   { 後手 ×  または 後手の勝ち.}
  12.   type  status     = x..o                   ;   { 盤の状態 または ｹﾞｰﾑ評価値.}
  13.         placeRange = 0..9                   ;   { 場所の範囲   (1～9がok).   }
  14.         tableType  = array[placeRange] of status;{ ゲーム盤の型.             }
  15.   var   table      : tableType              ;   { ゲーム盤.                  }
  16.         ox,you,com : status                 ;   { ○または×.                }
  17.         time       : integer                ;   { 1手目､2手目,3手目･･･ .     }
  18.  
  19. (****************************)
  20. (*       盤の表示処理       *)
  21. (****************************)
  22.   procedure print      ;
  23.     var p : placeRange ;
  24.   begin
  25.     for p:=1 to 9 do
  26.       begin  case table[p] of
  27.                o : write(' ○') ;
  28.                n : write( p:3 ) ;             { 置いていない場所は番号を表示.}
  29.                x : write(' ×')
  30.              end ;
  31.              if p mod 3 = 0 then writeln      { 3 つごとに改行する.          }
  32.       end ;
  33.     writeln
  34.   end {print} ;
  35.  
  36. (****************************)
  37. (*       初期設定処理       *)
  38. (****************************)
  39.   procedure init              ;
  40.     var p        : placeRange ;
  41.         ordinary : integer    ;
  42.   begin
  43.     writeln('コンピュータと３目並べをしよう！') ;
  44.     for p:=1 to 9 do table[p] := n  ;
  45.     write('先手○ 後手× を選んでネ(先手･･･1 後手･･･1以外) ? ') ;
  46.     read(ordinary)                  ;
  47.     if ordinary = 1 then you := o             { 先手は　○                   }
  48.                     else you := x   ;         { 後手は　× .                 }
  49.     com := -you                     ;         { コンピュータはあなたの逆.    }
  50.     print                                     { 置く場所を示すために盤を表示.}
  51.   end {init} ;
  52.  
  53. (****************************)
  54. (*   　３つ並び判定関数　   *) (*table に ox が 3つ並んでいれば真を返す *)
  55. (****************************)                                    {   table  }
  56.   function complete(table : tableType ; ox : status) : Boolean ;  {  1  2  3 }
  57.     var oooORxxx : -3..+3 ;                                       {  4  5  6 }
  58.   begin                                                           {  7  8  9 }
  59.     oooORxxx := ox * 3    ;
  60.     complete := (table[1]+table[2]+table[3] = oooORxxx) or        { １行目.  }
  61.                 (table[4]+table[5]+table[6] = oooORxxx) or        { ２行目.  }
  62.                 (table[7]+table[8]+table[9] = oooORxxx) or        { ３行目.  }
  63.                 (table[1]+table[4]+table[7] = oooORxxx) or        { １列目.  }
  64.                 (table[2]+table[5]+table[8] = oooORxxx) or        { ２列目.  }
  65.                 (table[3]+table[6]+table[9] = oooORxxx) or        { ３列目.  }
  66.                 (table[1]+table[5]+table[9] = oooORxxx) or        { 右下がり.}
  67.                 (table[3]+table[5]+table[7] = oooORxxx)           { 左下がり.}
  68.   end {complete} ;
  69.  
  70. (****************************)
  71. (*      最善の手を探す      *)
  72. (****************************)
  73. (***** time手目のtableについて ox を 置ける 最善のplace を 調べる｡
  74.    関数値:(ox･･勝ち  n･･引き分け  -ox･･負け) 負けの時  place は 無意味 *****)
  75.   function bestSelect(table : tableType ; ox : status ; time : integer ;
  76.                       var place : placeRange) : status ;
  77.     var p : placeRange ;
  78.  
  79.   (****************************)
  80.   (*      思考ルーチン        *)
  81.   (****************************)
  82.     function think : status ;
  83.       label 9                       ;                 { 関数出口.            }
  84.       var   p,pp       : placeRange ;                 { 置く場所 ppはダミー. }
  85.             memoplace  : placeRange ;                 { ワーク               }
  86.             eval       : status     ;                 { 評価値.              }
  87.     begin
  88.       (* まずその局面で勝てる場所を探す *)
  89.       for p := 1 to 9 do
  90.         begin
  91.           if table[p] = n then
  92.             begin
  93.               table[p] := ox ;
  94.               if complete(table,ox) then              {   ３つ揃えば         }
  95.                 begin
  96.                   place := p ;
  97.                   eval := ox ;                        {     勝ちが           }
  98.                   goto 9 {return}                     {     決定.            }
  99.                 end ;
  100.               table[p] := n
  101.             end
  102.         end ;
  103.       (* この局面だけでは勝てないので先読みする *)
  104.       memoPlace := 0 ;                                { ﾙｰﾌﾟ後も0なら負け.   }
  105.       for p := 1 to 9 do
  106.         begin
  107.           if table[p] = n then
  108.             begin
  109.               table[p] := ox ;                        {   そこに置いてみる.  }
  110.               eval := bestSelect(table,-ox,time+1,pp);{ 相手の最善手を調べる.}
  111.               if      eval = ox then
  112.                 begin
  113.                   place := p ;
  114.                   goto 9 {return}
  115.                 end
  116.               else if eval = n  then memoPlace :=p ; { 引き分けにできる場所.}
  117.               table[p] := n                          { 置いたのを取り消す.  }
  118.             end
  119.         end ;
  120.       if memoPlace = 0 then eval := -ox              { どこに置いても負け.  }
  121.                        else eval := n     ;          { 引き分けにできる.    }
  122.       place := memoPlace                  ;          { メモした場所を 返却. }
  123. 9:    think := eval
  124.     end {think} ;
  125.  
  126. (****** bestSelect 開始 *****)
  127.   begin {bestSelect}                                              {  1  2  3 }
  128.     case time of                                                  {  4  5  6 }
  129.                 1 : begin                                         {  7  8  9 }
  130.                       place      := 5 ;        {  1手目は真ん中              }
  131.                       bestSelect := n          {  勝負は未決                 }
  132.                     end ;
  133.                 2 : begin
  134.                       p := 1 ;
  135.                       while table[p] = n do p := p + 1 ;
  136.                       if p=5 then place := 1   { 真ん中に置かれたのなら1     }
  137.                              else place := 5 ; { 真ん中以外なら真ん中を取る  }
  138.                       bestSelect := n          { 勝負は未決                  }
  139.                     end ;
  140.       3,4,5,6,7,8 : bestSelect := think ;      { 3～8手目は手を考える        }
  141.                 9 : begin                      { 9手目(最後の手)は 残った所  }
  142.                       place := 1 ;
  143.                       while table[place] <> n do place := place + 1 ;
  144.                       bestSelect := n          { 勝負は引き分け              }
  145.                     end
  146.     end
  147.   end {bestSelect} ;
  148.  
  149. (****************************)
  150. (*     あなたの手の処理     *)
  151. (****************************)
  152.   procedure yourSelect  ;
  153.     var p  : integer    ;
  154.         ok : Boolean    ;
  155.         pp : placeRange ;
  156.   begin
  157.     repeat
  158.       if you = o then write('○')
  159.                  else write('×') ;
  160.       write('をどこに置くかい (0:ｱﾄﾞﾊﾞｲｽ  1～9:場所) ? ') ;
  161.       read(p) ;
  162.       if p = 0 then
  163.         begin
  164.           if bestSelect(table,you,time,pp) = com
  165.             then writeln('既に君の負けは決定しているよ')
  166.             else writeln(pp:2,'に置いたらどうかなあ') ;
  167.           ok := false
  168.         end
  169.       else if (1<=p) and (p<=9) then ok := table[p] = n
  170.                                 else ok := false
  171.     until ok ;                                    { 置ける場所が選ばれるまで.}
  172.     table[p] := you                               { 選んだ場所に置く.        }
  173.   end {yourSelect} ;
  174.  
  175. (****************************)
  176. (*  コンピュータの番の処理  *)
  177. (****************************)
  178.   procedure comSelect ;
  179.     var place : placeRange               ;      { 置く場所.                  }
  180.         d     : status                   ;      { 無意味だが処理上必要なもの.}
  181.   begin
  182.     write('コンピュータは')              ;
  183.     d := bestSelect(table,ox,time,place) ;      {  最善の手を選び            }
  184.     writeln(place:2,' に置こう')         ;
  185.     table[place] := com                         {     そこに 置く.           }
  186.   end {comSelect} ;
  187.  
  188. (****************************)
  189. (*      メイン処理          *)
  190. (****************************)
  191. begin {main}
  192.   init      ;                                         { 初期設定をする.      }
  193.   ox   := x ;                                         { ○を先手とするﾃｸﾆｯｸ. }
  194.   time := 0 ;                                         { 手数をクリアする.    }
  195.   repeat                                              { 決着か8手目までやる. }
  196.     time := time + 1 ;                                {   手数を進める.      }
  197.     ox   := -ox      ;                                {   ○×を反転する.    }
  198.     if ox = you then yourSelect                       {   あなたの番.        }
  199.                 else  comSelect  ;                    {   コンピュータの番   }
  200.     print                                             {   盤を表示する.      }
  201.   until complete(table,ox) or (time = 8{手目})  ;     { 9手目はしない.       }
  202.   if complete(table,ox) then                          { ３つ揃った時         }
  203.     if ox = you then writeln('コンピュータ故障！')    {   あなたは勝てない.  }
  204.                 else writeln('コンピュータの勝ち')    {   ｺﾝﾋﾟｭｰﾀが揃った.   }
  205.   else               writeln('引き分けだネ'      )    { 8手目未決は引き分け. }
  206. end {main}.
  207.